Exploration of some different scenarios for financial burndown based on various assumptions around present value, annual expenditures, annual returns.
Inputs needed:
Output is remaining balance at end of period.
## loop through each year, new calc based on balance at end of each year to get year-by-year schedule
startbal <- -600000
draw <- 60000
return <- 0.04
yrs <- 10
start_bal <- startbal
sched_all_s <- data.frame()
for(y in 1:yrs){
remain <- fv(r=return, n=1, pv=start_bal, pmt=draw, type=0)
sched <- data.frame('year'=y,
'balance'=remain)
sched_all_s <- bind_rows(sched_all_s, sched)
start_bal <- remain*-1
}
At end of 10 years, you will have $167,780 left.
sched_all_s %>% ggplot(aes(x=as.factor(year), y=balance))+geom_line(group=1)+
scale_y_continuous(labels=comma)+
labs(title=paste0("$",format(remain, big.mark=",", digits=0), " left after ", yrs, " years."),
y="", x="year from start")
## loop through each year, new calc based on balance at end of each year to get year-by-year schedule
scenarios <- tribble(
~startbal, ~draw, ~return, ~yrs,
-600000, 60000, 0.04, 20,
-700000, 60000, 0.03, 20,
-700000, 60000, 0.02, 20,
-800000, 60000, 0.02, 20,
-800000, 60000, 0.03, 20,
-1000000, 70000, 0.03, 20,
-1000000, 60000, 0.04, 20,
-800000, 60000, 0.04, 20
)
scenarios <- scenarios %>% mutate(
scenario=paste0(as.character(startbal/1000*-1),"k-",as.character(draw/1000),"k-",as.character(return*100),"%-", as.character(yrs),"y")
)
sched_all_scenario <- data.frame()
for(s in 1:nrow(scenarios)){
scen <- scenarios$scenario[s]
start_bal <- scenarios$startbal[s]
sched_all <- data.frame()
for(y in 1:scenarios$yrs[s]){
remain <- fv(r=scenarios$return[s], n=1, pv=start_bal, pmt=scenarios$draw[s], type=0)
sched <- data.frame('scenario'=scen,
'year'=y,
'balance'=remain)
sched_all <- bind_rows(sched_all, sched)
start_bal <- remain*-1
}
sched_all_scenario <- bind_rows(sched_all_scenario, sched_all)
}
pbar <- sched_all_scenario %>% ggplot(aes(x=year, y=balance, fill=scenario))+geom_col(position = position_dodge())+
scale_y_continuous(labels=comma)+
labs(title=paste0("How much left after ", max(scenarios$yrs), " years in different scenarios"),
y="", x="year from start")
ggplotly(pbar)
pline <- sched_all_scenario %>% ggplot(aes(x=year, y=balance, color=scenario))+geom_line()+
geom_hline(yintercept=0)+
scale_y_continuous(labels=comma)+
labs(title=paste0("How much left after ", yrs, " years in different scenarios"),
y="", x="year from start")
ggplotly(pline)
## number of simulations
nsims <- 100
## number of years to simulate
yrs <- 20
## parameters for starting, return, draw - exact numbers determined in loop
## min and max starting balance
start_min <- 600000
start_max <- 900000
## return rate
r_mean <- 0.03
r_sd <- 0.07
r_max <- 0.20
## draw
draw_min <- 50000
draw_max <- 75000
sim_all <- data.frame()
for(s in 1:nsims){
sim <- s
bal_start <- round(runif(n=1, min=start_min, max=start_max),0)
bal_start_set <- bal_start
bal_start_no_draw <- bal_start
sim_sched <- data.frame()
for(y in 1:yrs){
rrate <- round(min(rnorm(n=1, mean=r_mean, sd=r_sd), r_max), 3)
draw <- round(runif(n=1, min=draw_min, max=draw_max),0)
return <- round(bal_start*rrate, 0)
bal_remain <- ifelse(bal_start>0,bal_start+return-draw,bal_start-draw)
bal_no_draw <- round(bal_start_no_draw*(1+rrate),0)
sim_yr <- data.frame('sim'=sim,
'year'=y,
'start'=bal_start,
'rrate'=rrate,
'return'=return,
'draw'=draw,
'balance'=bal_remain,
'bal_no_draw'=bal_no_draw)
sim_sched <- bind_rows(sim_sched, sim_yr)
bal_start <- bal_remain
bal_start_no_draw <- bal_no_draw
}
sim_all<- bind_rows(sim_all, sim_sched)
}
sim_all$sim <- as.factor(sim_all$sim)
psim <- sim_all %>% ggplot(aes(x=year, y=balance, color=sim))+geom_line()+
geom_hline(yintercept=0)+
scale_y_continuous(labels=comma)+
theme(legend.position = 'none')+
labs(title=paste0("How much left after ", yrs, " years in different simulations"),
y="", x="year from start")
ggplotly(psim)
chart_title <- "Distribution of End Balances"
sim_all %>% ggplot(aes(x=balance))+geom_histogram()+
labs(title=chart_title)
sim_all <- sim_all %>% filter(year==20) %>% mutate(
pos=ifelse(balance>0,"money","no money")
)
sim_all %>% ggplot(aes(x=pos))+geom_bar()+
labs("How likely to run out of money???")
sim_neg <- sim_all %>% filter(balance<=0)
sim_neg_yr <- sim_neg %>% group_by(sim) %>% summarize(yr=min(year))
sim_neg_yr %>% ggplot(aes(x=yr))+geom_bar()+
labs(title="Distribution of Years when Balance = $0")
For those simulations that go below $0 with end balance.
chart_title <- "Distribution of Returns in Sims"
hist1 <- sim_all %>% ggplot(aes(x=rrate))+geom_histogram()+
geom_vline(xintercept=mean(sim_all$rrate), linetype='dotted')+
scale_y_continuous(expand=expansion(add=c(0,1)))+
scale_x_continuous(labels=percent)+
labs(title=chart_title)
mrate_all <- mean(sim_all$rrate)
sdrate_all <- sd(sim_all$rrate)
## calc returns when draw downs excluded
sim_rr <- sim_all %>% group_by(sim) %>% summarize(start_bal=first(start),
end_bal=last(bal_no_draw),
yrs=max(year)) %>%
mutate(ttl_return=end_bal/start_bal-1,
ttl_return_ave=ttl_return/yrs)
chart_title <- "Distribution of Real Returns in Sims (no draw)"
hist2 <- sim_rr %>% ggplot(aes(x=ttl_return_ave))+geom_histogram()+
geom_vline(xintercept=mean(sim_rr$ttl_return_ave), linetype='dotted')+
scale_y_continuous(expand=expansion(add=c(0,1)))+
scale_x_continuous(labels=percent)+
labs(title=chart_title)
grid.arrange(hist1, hist2, nrow=1)
Mean rate of return (straight ave): 0.03064
Std dev rate of return (straight sd): 0.0669992
Mean total rate of return, no draws: -0.0598149
Std dev rate of return, no draws: 1.919092
chart_title <- "Returns over time"
sim_all %>% ggplot(aes(x=as.factor(year), y=return))+geom_boxplot()+
geom_hline(yintercept = 0)+
scale_y_continuous(labels=comma)+
labs(title=chart_title)
chart_title <- "Draws over time"
sim_all %>% ggplot(aes(x=as.factor(year), y=draw))+geom_boxplot()+
geom_hline(yintercept=mean(sim_all$draw), linetype='dashed')+
scale_y_continuous(labels=comma)+
labs(title=chart_title, x='year from start')
## identify sims where balance > 0 at year 20
sim_pos <- sim_all[sim_all$year==20 & sim_all$balance>0,]
sim_pos_rate <- nrow(sim_pos)/nsims
## filter full list for positive sims only
sim_pos_filter <- sim_pos %>% select(sim)
sim_pos_all <- left_join(sim_pos_filter, sim_all, by='sim')
## summarize individual sims
sim_pos_ind_smry <- sim_pos_all %>% group_by(sim) %>% summarize(
start_bal=first(start),
ave_rate=round(mean(rrate),3),
ave_draw=round(mean(draw),0),
end_bal=last(balance)
)
chart_title <- paste0("Ending Balance after ", yrs," yrs for positive sims")
sim_pos %>% ggplot(aes(x=reorder(sim, -balance), y=balance))+geom_col(position=position_dodge())+
scale_y_continuous(labels=comma, expand=expansion(mult=c(0,0.05)))+
labs(title=chart_title, x='sim')
sim_pos_smry <- sim_pos_ind_smry %>% summarize(
ave_start=mean(start_bal),
ave_rate=mean(ave_rate),
ave_draw=mean(ave_draw),
end_bal=mean(end_bal)
)
sim_pos_smry
## # A tibble: 1 x 4
## ave_start ave_rate ave_draw end_bal
## <dbl> <dbl> <dbl> <dbl>
## 1 278460. 0.0503 60336. 233231
sim_pos_ind_smry
## # A tibble: 7 x 5
## sim start_bal ave_rate ave_draw end_bal
## <fct> <dbl> <dbl> <dbl> <dbl>
## 1 6 188769 -0.042 73102 107739
## 2 16 870910 0.063 51689 874088
## 3 22 153874 -0.016 61432 89980
## 4 38 197971 0.052 59185 149080
## 5 57 141447 0.198 60752 108702
## 6 78 281509 0.071 52122 249374
## 7 99 114738 0.026 64067 53654
## DT to add table of all rows for each positive sim for inspection
datatable(sim_pos_all)
chart_title <- 'Distributions in Annual Returns across positive sims'
sim_pos_all %>% ggplot(aes(x=sim, y=rrate))+geom_boxplot()+
geom_hline(yintercept = 0)+
labs(title=chart_title)
Do sims in the positive set have both high starting AND high returns?
sim_pos_ind_smry %>% ggplot(aes(x=start_bal, y=ave_rate))+geom_point()